home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / basic / qb4men.zip / MIKEBAR.BAS
BASIC Source File  |  1987-12-26  |  11KB  |  311 lines
  1. 'Bounce-bar menu routine for Microsoft QuickBasic 4.0
  2. 'By Michael J. Himowitz, 8134 Scotts Level Rd, Baltimore, MD 21208
  3. 'CIS 71655,1327, Delphi MHIMOWITZ
  4. '
  5. 'This set of routines will allow you to set up and call a series
  6. 'of Bounce-Bar type menus in QB4. The user may select a choice from
  7. 'a menu by moving the UP and DOWN cursor keys to highlight the choice
  8. 'and then hitting RETURN to make his selection. Or, he can just type
  9. 'the number opposite the choice. The user's choice (a number from 1 to 9)
  10. 'is returned to the program in a variable named CH. I've set up four menus
  11. 'in various colors (some pretty hideous) to demonstrate the program.
  12. 'You can monkey with the colors to your heart's content.
  13. '
  14. 'The program makes use of two major routines. The first is a generic
  15. 'box drawing routine that can be used to draw a box on the screen anywhere.
  16. 'Here I used it to frame the entire screen for the menu. The second
  17. 'is the routine that creates the bounce-bar menu. I adapted it for the
  18. 'compiler from an interpreter routine by Frank R. Neal, whom I've never
  19. 'met but to whom I'm indebted for making me look like a much better
  20. 'programmer than I really am. The code here is fully commented. Just
  21. 'remember to set up your choices for each menu in the array M$() and tell
  22. 'the menu routine how many choices to display by assigning the number
  23. 'of choices to the variable NP. Hope you find this useful.
  24. '
  25. ' I've also thrown in a demo of a routine that boxes text in any
  26. ' color. It's available from the first menu.
  27.  
  28. DECLARE SUB box (r1%, c1%, R2%, c2%, men%)  ' Be sure to include these
  29. DECLARE SUB rmsg (whichline!, tl$)          ' lines at the top of your
  30. DECLARE SUB menu (front, back, border)      ' program. And of course, you
  31. DIM SHARED m$(10), np, ch, yn$              ' must include the subroutines
  32. DECLARE SUB yesorno ()                      ' they reference.
  33. DECLARE SUB center (whichline, tl$)         '
  34. DECLARE SUB box.text (msg$, row%, col%, front, back, ofront, oback)
  35. DECLARE SUB hold ()
  36.  
  37. Second.title$ = "This is the Second Line of The Menu Title"
  38. bottom.msg$ = "This is the bottom line of the Menu Screen"
  39.  
  40. 'Note: the two variables above are for the second line of the menu title
  41. 'and the line that goes at the bottom of the menu screen.
  42. 'You can substitute anything you want here, or make them part of each
  43. 'menu routine as you call the menu.
  44.  
  45. 7
  46. '======= This starts the calling code for Menu No. 1 =======
  47.  
  48. first.menu:
  49.     m$(1) = "Go to Menu 2"   'These are the menu choices
  50.     m$(2) = "Go to Menu 3"   'that will be printed on the screen
  51.     m$(3) = "Go to Menu 4"
  52.     m$(5) = "Quit the Demo"
  53.     m$(4) = "Demo of Boxed Text"
  54. np = 5                     'This is the total number of choices
  55.                'You have a maximum of nine choices
  56.  
  57. COLOR 1, 7, 7              'This sets the overall screen colors
  58. CLS
  59. CALL box(1, 1, 24, 79, 1)  'Parameters are starting row, starting column,
  60.                'ending row and ending column. The last parameter,
  61.                'set to 1, puts bars at the top and bottom of the
  62.                'box to set off the title and bottom line of a
  63.                'menu screen. If you set the last parameter to
  64.                'zero, you'll just get a box.
  65.  
  66. CALL center(2, "This is the First Menu Title") 'Prints the first menu title
  67. CALL center(3, Second.title$)                  'Prints the second menu title
  68. CALL center(23, bottom.msg$)                   'Bottom line message
  69.  
  70. menu 4, 7, 7               'The parameters are the foreground, background
  71.                'and border colors for the menu printing
  72.  
  73. CLS
  74. ON ch GOTO second.menu, third.menu, fourth.menu, box.demo, quittin.time
  75.  
  76. '=======  This is the end of the first menu call ===========
  77. '=======  The value of the menu choice is returned in variable CH ======
  78.  
  79.  
  80.  
  81.  
  82.  
  83. second.menu:
  84.     m$(1) = "Go to First Menu"
  85.     m$(2) = "Go to Third Menu"
  86.     m$(3) = "Go to the Fourth Menu"
  87.     m$(4) = "Quit The Demo"
  88.     np = 4
  89.     COLOR 7, 0, 0
  90.     CLS
  91.     CALL box(1, 1, 24, 79, 1)
  92.     CALL center(2, "This is Menu No. 2")
  93.     CALL center(3, Second.title$)
  94.     CALL center(23, bottom.msg$)
  95.     CALL menu(14, 0, 0)
  96.     ON ch GOTO first.menu, third.menu, fourth.menu, quittin.time
  97.  
  98. third.menu:
  99.        
  100.     m$(1) = "Go to First Menu"
  101.     m$(2) = "Go to Second Menu"
  102.     m$(3) = "Go to the Fourth Menu"
  103.     m$(4) = "Quit The Demo"
  104.     np = 4
  105.     COLOR 7, 4, 4
  106.     CLS
  107.     CALL box(1, 1, 24, 79, 1)
  108.     CALL center(2, "This is Menu No. 3")
  109.     CALL center(3, Second.title$)
  110.     CALL center(23, bottom.msg$)
  111.     CALL menu(0, 4, 4)
  112.     ON ch GOTO first.menu, second.menu, fourth.menu, quittin.time
  113.  
  114. fourth.menu:
  115.        
  116.     m$(1) = "Go to First Menu"
  117.     m$(2) = "Go to Second Menu"
  118.     m$(3) = "Go to the Third Menu"
  119.     m$(4) = "Quit The Demo"
  120.     np = 4
  121.     COLOR 7, 1, 1
  122.     CLS
  123.     CALL box(1, 1, 24, 79, 1)
  124.     CALL center(2, "This is Menu No. 4")
  125.     CALL center(3, Second.title$)
  126.     CALL center(23, bottom.msg$)
  127.     CALL menu(6, 1, 1)
  128.     ON ch GOTO first.menu, second.menu, third.menu, quittin.time
  129.  
  130. quittin.time:
  131.     COLOR 7, 0, 0: CLS
  132.     SOUND 1200, 2
  133.     CALL rmsg(10, "Do you want to Quit? (Y/N)")
  134.     yesorno
  135.     IF yn$ <> "Y" THEN GOTO first.menu
  136.     END
  137.  
  138.  
  139. box.demo:        'This is a demo of how to box text
  140. COLOR 7, 0, 0    'in any color. For explanation, see the
  141. CLS              'remarks in the box.text subprogram
  142.  
  143. box.text "This is some text", 3, 8, 7, 1, 7, 0
  144. box.text "Here's some more text", 7, 15, 4, 1, 7, 0
  145. box.text "And another piece of text", 22, 40, 1, 6, 7, 0
  146. box.text "Here's some more stuff", 12, 33, 15, 13, 7, 0
  147. box.text "Now is the time for all good men", 19, 16, 2, 0, 7, 0
  148. SOUND 1200, 2
  149. COLOR 7, 0
  150. center 25, "Strike the space bar repeatedly to make the boxes disappear."
  151.  
  152. 'The following routines erase the boxes one by one.
  153.  
  154. hold
  155. box.text "Now is the time for all good men", 19, 16, 0, 0, 7, 0
  156. hold
  157. box.text "Here's some more stuff", 12, 33, 0, 0, 7, 0
  158. hold
  159. box.text "And another piece of text", 22, 40, 0, 0, 7, 0
  160. hold
  161. box.text "Here's some more text", 7, 15, 0, 0, 7, 0
  162. hold
  163. box.text "This is some text", 3, 8, 0, 0, 7, 0
  164. CLS
  165. GOTO first.menu
  166.  
  167.  
  168. END
  169.  
  170. SUB box (r1%, c1%, R2%, c2%, men%)
  171.  
  172. ' DRAW A BOX AT SPECIFIED COORDINATE
  173. ' This is a generic routine that can be used to draw a box anywhere.
  174. ' r1% is the starting row. c1% is the starting column.
  175. ' r2% is the ending row. c2% is the ending column.
  176. ' The paramater men%, set to 1, prints horizontal bars
  177. ' three rows down from the top of the box and two rows up from the bottom.
  178. ' If men% is set to 0, the routine will print a plain box.
  179.  
  180.      GLOOP$ = "║"
  181.       BOXTOP = (c2% - c1%) - 1: BOXTOP$ = CHR$(201) + STRING$(BOXTOP, 205) + CHR$(187): BOXBOTTOM$ = CHR$(200) + STRING$(BOXTOP, 205) + CHR$(188)
  182.       MIDBOX$ = CHR$(204) + STRING$(BOXTOP, 205) + CHR$(185)
  183.       LOCATE r1%, c1%: PRINT BOXTOP$; : FOR E1% = r1% + 1 TO R2% - 1: LOCATE E1%, c1%: PRINT GLOOP$; : LOCATE E1%, c2%: PRINT GLOOP$; : NEXT
  184.       LOCATE R2%, c1%: PRINT BOXBOTTOM$;
  185.       IF men% > 0 THEN   'Prints optional top and bottom bars in box
  186.        LOCATE r1% + 3, c1%: PRINT MIDBOX$;
  187.        LOCATE R2% - 2, c1%: PRINT MIDBOX$;
  188.        END IF
  189.  
  190. END SUB
  191.  
  192. SUB box.text (tl$, r1%, c1%, fgd, bkg, ofg, obk)
  193.      
  194.       ' BOX TEXT AT SPECIFIED COORDINATE
  195.       'This routine will box a one-line string of text in the color
  196.       'of your choice at the starting coordinate you choose.
  197.       'TL$ is the text, r1% is the starting row, c1% is the starting column.
  198.       'fgd and bkg are the fore and background colors of the boxed text.
  199.       'ofg and obk are the colors to restore after you've boxed the text.
  200.        
  201.        
  202.     GLOOP$ = "║"
  203.     BOXTOP = LEN(tl$) + 2
  204.     BOXTOP$ = CHR$(201) + STRING$(BOXTOP, 205) + CHR$(187): BOXBOTTOM$ = CHR$(200) + STRING$(BOXTOP, 205) + CHR$(188)
  205.     MIDBOX$ = GLOOP$ + " " + tl$ + " " + GLOOP$
  206.     COLOR fgd, bkg
  207.     LOCATE r1%, c1%: PRINT BOXTOP$; : E1% = r1% + 1: R2% = E1% + 1
  208.     LOCATE E1%, c1%: PRINT MIDBOX$;
  209.     LOCATE R2%, c1%: PRINT BOXBOTTOM$;
  210.     COLOR ofg, obk  'switch to these text colors after boxing the text
  211.  
  212. END SUB
  213.  
  214. SUB center (whichline, tl$)
  215.  'This is a simple routine that centers a string of text TL$  
  216.  'on line number WHICHLINE. You can use it anywhere.
  217.  
  218.     tl = LEN(tl$)
  219.     tl = INT((80 - tl) / 2)
  220.     LOCATE which